home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-11-29 | 2.1 KB | 110 lines | [TEXT/PJMM] |
- unit TKeyGroup;
-
- { ⌐1986-1989 Bill Stackhouse }
- { Stackhouse Software }
- { Natick, MA 01760 }
-
- interface
-
- {$IFC UNDEFINED UseKeyGroup}
- {$SETC UseKeyGroup = FALSE}
- {$ENDC}
- {$IFC UseKeyGroup}
-
- uses
- TObject;
-
- const
- maxKeys = 25;
-
- type
- TKeyGroup = object(TObject)
- numKeyGroups: 0..maxKeys; {number of key/button groups}
- KeyGroup: array[1..maxKeys] of record
- key: char; {command key character to press to activate}
- btn: Integer; {this button}
- end;
- procedure TKeyGroup.Init;
- procedure TKeyGroup.Add (pKey: char;
- pBtn: Integer);
- function TKeyGroup.Click (theKey: Char): Integer;
- function TKeyGroup.Error: Integer;
- end;
-
- {$ENDC}
-
- implementation
-
- {$IFC UseKeyGroup}
-
- const
- Off = 0;
- On = 1;
-
- btnCtrlItem = 4;
- chkCtrlItem = 5;
- radCtrlItem = 6;
- editCtrlItem = 16;
-
- DialogGroupIgnored = -10; {too many groups, key, menus, or user items were added}
-
- type
- TSearch = (searching, found, endList);
-
- var
- globalError: Integer;
-
- procedure TKeyGroup.Init;
- begin
- globalError := noErr;
- SELF.numKeyGroups := 0;
- end; {TKeyGroup.Init}
-
- procedure TKeyGroup.Add (pKey: char;
- pBtn: Integer);
- begin
- globalError := noErr;
- with SELF do
- if numKeyGroups < maxKeys then
- begin
- numKeyGroups := numKeyGroups + 1;
- with KeyGroup[numKeyGroups] do
- begin
- key := pKey;
- btn := pBtn;
- end;
- end
- else
- globalError := DialogGroupIgnored;
- end; {TKeyGroup.Add}
-
- function TKeyGroup.Click (theKey: Char): Integer;
- var
- index: Integer;
- state: TSearch;
- begin
- globalError := noErr;
- state := searching;
- index := 1;
- repeat
- if (SELF.KeyGroup[index].key = theKey) then
- state := found
- else if index > SELF.numKeyGroups then
- state := endList
- else
- index := index + 1;
- until (state <> searching);
- if (state = found) then
- Click := SELF.KeyGroup[index].btn
- else
- Click := 0;
- end; {TKeyGroup.Key}
-
- function TKeyGroup.Error: Integer;
- begin
- Error := globalError;
- end; {TKeyGroup.Error}
-
- {$ENDC}
-
- end.